home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-01 / cexpert.zip / MCH4.LST < prev    next >
File List  |  1990-09-15  |  19KB  |  799 lines
  1.            Listing 4-1 C/C++ Program CAR, CDR, ATOM
  2.  
  3. /* cons.h
  4. typedef struct _cons {        /* a cons-cell */
  5.     union {
  6.       struct _cons  *p;
  7.       char          *s;
  8.     } car;
  9.     struct _cons  *cdr;        /* usually points to a sublist */
  10.     unsigned char type;        /* the types of the pointers in the cells */
  11. } cons;
  12.  
  13. #define CAR_STRING    1
  14. #define CAR_INTEGER    2
  15. #define CAR_LIST    4
  16. #define CDR_STRING    8
  17. #define CDR_INTEGER    16
  18. #define CDR_LIST    32
  19.  
  20. #define C_FILE        0
  21. #define C_STRING    1
  22.  
  23. #define ATOM(x) ((x)->type != CAR_LIST)
  24. #define CAR(x) (x)->car.p
  25. #define CDR(x) (x)->cdr
  26. #define HEAD CAR
  27. #define TAIL CDR
  28.  
  29. cons *mkcons(),*lread();
  30. cons *nsubst(),*copy_list(),*mklist2();
  31. cons *member(),*nconc(),*nreverse();
  32. cons *unify_equal(),*unify_term_c(),*unify_pred_c(),*unify_list_c_1();
  33. cons *unify_pred_nv(),*unify_list_nv_1();
  34.  
  35. cons *twotees(),*ltwotees();
  36. cons *join_subst(),*subst_list();
  37.  
  38.  
  39.  
  40.  
  41.  
  42.  
  43.          Listing 4-2 Utility Functions for LISP Conversion
  44.  
  45.  
  46. /*
  47. ** UTIL.C
  48. **
  49. ** Emulation of LisP utilities
  50. */
  51.  
  52. #include <stdio.h>
  53. #include "cons.h"
  54. #include "goal.h"
  55.  
  56. /*
  57. ** nsubst(): replace surgically every occurrence of _old_ with _new_ in the
  58. ** list _list_.
  59. */
  60.  
  61. /*--------------------------------------------------nth_list()-----------*/
  62.  
  63. /*
  64. **  Usage:
  65. **  E.x.  n = 2, list = (((?x 3)(?y 5))(?z 1)((?m 4)))
  66. **        nth_list(n,list) ===> (?z 1)
  67. **
  68. */
  69.  
  70. cons  *nth_list(n,list)
  71. int   n;                     
  72. cons  *list;
  73. {
  74.     int  i;
  75.     cons *substp = list;
  76.     
  77.     for(i = 1; i < n; i++)
  78.     {
  79.         substp = CDR(substp);
  80.     }
  81.     return(mkcons(CAR_LIST,CAR(substp),NULL));
  82. }
  83.  
  84.     
  85. /*---------------------------------------------------mkcons()-----------*/
  86.  
  87. /*
  88. **  Usage:
  89. **  E.x.   mkcons(CAR_LIST,(?x 1),(?y 2)) ===> ((?x 1)(?y 2))
  90. **
  91. */
  92.  
  93.  
  94. cons *mkcons(type,head,tail)
  95. cons *head,*tail;
  96. {
  97.   cons *p;  
  98.   if (p = (cons *) malloc(sizeof(cons))) {
  99.     p->type  = type;
  100.     p->car.p = head;
  101.     p->cdr   = tail;
  102.   } else {
  103.     puts("\n*** Yow! Out of core ***\n");
  104.   }
  105.   return p;
  106. }
  107.  
  108.  
  109. /*-----------------------------------------------------killcons-----------*/
  110.  
  111.  
  112. killcons(p)
  113. cons *p;
  114. {
  115.   if (p != NULL) {
  116.     if ((p->type & CAR_LIST) == CAR_LIST) {
  117.       killcons(p->car.p);
  118.       killcons(p->cdr);
  119.     } else if ((p->type & CAR_STRING) == CAR_STRING) {
  120.       free(p->car.s);                /* get rid of the string */
  121.     }
  122.     free(p);
  123.   }
  124. }
  125.  
  126.  
  127. /*----------------------------------------------------nsubst()------------*/
  128.  
  129. cons *nsubst(new,old,list)
  130. char *new,*old;
  131. cons *list;
  132. {
  133.   cons *t;
  134.   char *strsave();
  135.   
  136.   if (list == NULL) {
  137.     t = NULL;
  138.   } else if (list->type == CAR_STRING) {
  139.     if (!strcmp(list->car.s,old)) {
  140.       killcons(list);
  141.       t = mkcons(CAR_STRING,strsave(new),NULL);
  142.     } else {
  143.       t = list;
  144.     }
  145.   } else {
  146.     list->car.p = nsubst(new,old,list->car.p);
  147.     list->cdr   = nsubst(new,old,list->cdr);
  148.     t = list;
  149.   }
  150.   return t;
  151. }
  152.  
  153. /*-----------------------------------------------------copy_list()-------*/
  154.  
  155. /*
  156. ** copy_list(): copy a list structure, down to the last atom, string &c.
  157. */
  158.  
  159. cons *copy_list(list)
  160. cons *list;
  161. {
  162.   cons *t;
  163.   if (list == NULL) {
  164.     t = NULL;      
  165.   } else if (list->type == CAR_STRING) {
  166.     t = mkcons(CAR_STRING,strsave(list->car.s),NULL);
  167.   } else {
  168.     t = mkcons(CAR_LIST,copy_list(list->car.p),copy_list(list->cdr));
  169.   }
  170.   return t;
  171. }
  172.  
  173.  
  174. /*-----------------------------------------------------length()---------*/
  175.  
  176. /*
  177. ** length(): returns the length of a list (counting only the 'top' or
  178. ** backbone elements, i.e.:
  179. ** length( '(a b (c d) e)) == 4, not 5
  180. */
  181.  
  182. int length(lp)
  183. cons *lp;
  184. {
  185.   int l = 0;
  186.   
  187.   if (ATOM(lp))
  188.     return 0;      
  189.   while (lp != NULL) {
  190.     ++l;
  191.     lp = lp->cdr;
  192.   }
  193.   return l;
  194. }
  195.  
  196.  
  197.  
  198. /*----------------------------------------------------mklist2()----------*/
  199.  
  200. /*
  201. ** mklist2(): make a two-element list out of the given string arguments.
  202. **
  203. ** Usage: E.x. mklist2("x","y") ===> (x y)
  204. **
  205. */
  206. cons *mklist2(foo,bar)
  207. char *foo,*bar;
  208. {
  209.   return mkcons(CAR_LIST,mkcons(CAR_STRING,strsave(foo),NULL),
  210.              mkcons(CAR_LIST,mkcons(CAR_STRING,strsave(bar),NULL),
  211.                      NULL));
  212. }
  213.  
  214.  
  215. /*-------------------------------------------------member_list()----------*/
  216.  
  217. /*
  218. ** member_list(): searches for the first occurrence of list1 in the list2.
  219. ** Searches are done on the top-level only, and only deal with length(list1)
  220. ** equal 1. 
  221. ** Return SUCCEED of FAIL
  222. ** Usage: E.g. member_list((?x 1),((?y 2)(?x 1))) ===> SUCCEED
  223. **             member_list((?x 1),(((?x 1)))) ===> FAIL
  224. **
  225. ** Author:      Sony Y. Song
  226. ** Date:        7/13/88
  227. ** 
  228. */
  229.  
  230. cons *member_list(list1,list2)
  231. cons *list1,*list2;
  232. {
  233.   int  i;
  234.   cons *temp1;
  235.   
  236.   if(list1 == NULL)
  237.   {
  238.     return SUCCEED;
  239.   }
  240.   for(i = 1; i <= length(list2); i++)
  241.   {
  242.       temp1 = nth_list(i,list2);
  243.       if(equal(list1,CAR(temp1)))
  244.       {
  245.           return SUCCEED;
  246.       }
  247.   }
  248.   return FAIL;
  249. }
  250.  
  251.  
  252. /*----------------------------------------------------variablep()----------*/
  253.  
  254. /*
  255. ** variablep(): Quick function, returns 'true' if the first character of
  256. ** var is '?' and 'false' if not.
  257. */
  258.  
  259. int variablep(var)ècons *var;
  260. {
  261.   return (ATOM(var) && *(var->car.s) == '?');
  262. }
  263.  
  264.  
  265. /*-----------------------------------------------------equal()-------------*/
  266.  
  267. /*
  268. ** equal(): determine whether two lisp constructs are equal
  269. */
  270.  
  271. int equal(l1,l2) 
  272. cons *l1,*l2;
  273. {
  274.   if (l1 == NULL && l2 == NULL) {
  275.     return 1;
  276.   } else if (l1 == NULL || l2 == NULL) {
  277.     return 0;
  278.   } else if (l1->type == CAR_STRING && l1->type == CAR_STRING) {
  279.     return !strcmp(l1->car.s,l2->car.s);
  280.   } else if (l1->type == CAR_LIST && l2->type == CAR_LIST) {
  281.     return (equal(l1->car.p,l2->car.p) && equal(l1->cdr,l2->cdr));
  282.   } 
  283. }
  284.  
  285.  
  286. /*------------------------------------------------nconc()----------------*/
  287.  
  288. /*
  289. ** nconc(): surgically concatenate two lists. Appends list2 to the end of 
  290. ** list 1 and returns the modified list1/list2 complex.Only used in backward
  291. ** chaining.
  292. ** Modified from nconc_lisp. Add some test cases.
  293. ** Usage: E.g. nconc(((?x 1)(?y 2)),(?z 3)) ===> ((?x 1)(?y 2)(?z 3))
  294. **        E.g. nconc((t t),(t t)) ===> (t t)
  295. **        E.g. nconc((?x 1),(?x 1)) ===> (?x 1)
  296. **
  297. ** 10-Jun-88    John Källén    Original code.
  298. ** 14-Jul-88    Sony Y.Song     Add some test cases.
  299. */
  300.  
  301. cons *nconc(list1,list2)
  302. cons *list1,*list2;
  303. {
  304.   cons *olist1;
  305.  
  306.   olist1 = list1;
  307.   if (list1 == NULL)
  308.   {
  309.       return list2;
  310.   }
  311.   if(equal(list1,ltwotees()) && equal(list2,ltwotees()))
  312.   {
  313.       olist1 = ltwotees();è      return olist1;
  314.   }
  315.   if(!equal(list1,ltwotees())&&equal(list2,ltwotees()))
  316.   {
  317.       return list1;
  318.   }
  319.   if(!equal(list2,ltwotees())&&equal(list1,ltwotees()))
  320.   {
  321.       return list2;
  322.   }
  323.   if(equal(list1,list2))
  324.   {
  325.       return list1;
  326.   }
  327.   if(!ATOM(CAR(list1))&&member_list(list1,list2))
  328.   {
  329.       return list2;
  330.   }
  331.   while (list1->cdr != NULL) {
  332.     list1 = list1->cdr;
  333.   }
  334.   list1->cdr = list2;
  335.   return olist1;
  336. }
  337.  
  338.  
  339. /*----------------------------------------------nconc_lisp()----------------*/
  340.  
  341. /*
  342. ** nconc_lisp():surgically concatenate two lists. Appends list2 to the end of 
  343. ** list 1 and returns the modified list1/list2 complex.
  344. */
  345.  
  346. cons *nconc_lisp(list1,list2)
  347. cons *list1,*list2;
  348. {
  349.   cons *olist1;
  350.  
  351.   olist1 = list1;
  352.   if (list1 == NULL)
  353.   {
  354.       return list2;
  355.   }
  356.   while (list1->cdr != NULL) {
  357.     list1 = list1->cdr;
  358.   }
  359.   list1->cdr = list2;
  360.   return olist1;
  361. }
  362.  
  363.  
  364. /*--------------------------------------------------nreverse()-------------*/
  365.  
  366. /*
  367. ** nreverse(): destructively reverses a listè*/
  368.  
  369. cons *nreverse(list)
  370. cons *list;
  371. {
  372.   cons *tmpcdr;
  373.   
  374.   if (list == NULL || list->cdr == NULL) {
  375.     return list;
  376.   }
  377.   tmpcdr = list->cdr;
  378.   list->cdr = NULL;
  379.   return nconc(nreverse(tmpcdr),list);
  380. }
  381.  
  382.  
  383. /*---------------------------------------------------fgetword()------------*/
  384.  
  385. /*
  386. ** read a space-delimited word from the input file _fp_ and put it in _buf_
  387. */
  388.  
  389. void fgetword(fp,buf)
  390. FILE *fp;
  391. char *buf;
  392. {
  393.   int c;
  394.   
  395.   while ((c = getc(fp)) != EOF && strchr(" \t\n",c)) /* skip whitespace */
  396.     ;
  397.   *buf++ = c;
  398.   while ((c = getc(fp)) != EOF && !strchr(" \t\n()",c)) { /* get all reals */
  399.     *buf++ = (char) c;
  400.   }
  401.   *buf = '\0';                        /* delimit */
  402. }
  403.  
  404. /*---------------------------------------------------push()----------------*/
  405.  
  406. /*
  407. **  push(item,list): the item is consed onto the front of the list.
  408. **  Usage: E.g. push(((?x 1)),((?y 2))) ===> (((?x 1))(?y 2))
  409. **
  410. **  Author:         Sony Y. Song
  411. **  Date:           7/07/88
  412. */
  413.  
  414. cons    *push(item,list)
  415. cons    *item,*list;
  416. {
  417.     return mkcons(CAR_LIST,item,list);
  418. }
  419.  
  420.  
  421.              Listing 4-3 Substitution a Sample LISP-C Conversion Program 
  422.  
  423. /*
  424. **  substitu.c:  Functions for manipulating substitutions.
  425. **
  426. */
  427.  
  428. /*--------------------------------------------------include--------------*/
  429.  
  430. #include <stdio.h>
  431. #include "cons.h"
  432.  
  433.  
  434. /*--------------------------------------------------twotees()------------*/
  435.  
  436. cons *twotees() 
  437. {
  438.   static cons *tt = NULL;
  439.   
  440.   if (tt == NULL) {
  441.     tt = mklist2("t","t");
  442.   } 
  443.   return tt;
  444. }
  445.  
  446.  
  447.  
  448. /*--------------------------------------------------ltwotees()------------*/
  449.  
  450. cons *ltwotees()
  451. {
  452.   static cons *ltt = NULL;
  453.  
  454.   if (ltt == NULL) {
  455.     ltt = mkcons(CAR_LIST,twotees(),NULL);
  456.   }
  457.   return ltt;
  458. }
  459.  
  460.  
  461.  
  462. /*--------------------------------------------------lltwotees()------------*/
  463.  
  464. cons *lltwotees()
  465. {
  466.   static cons *lltt = NULL;
  467.  
  468.   if (lltt == NULL) {
  469.     lltt = mkcons(CAR_LIST,ltwotees(),NULL);
  470.   }
  471.   return lltt;
  472. }
  473.  
  474.  
  475. /*--------------------------------------------------join_subst()------------*/è
  476. /*
  477. ** z1 is subst for ONE term.
  478. */
  479.  
  480. cons *join_subst(z1,z2)
  481. cons *z1,*z2;
  482. {
  483.   cons *retval;
  484.   
  485.   if (equal(z1,ltwotees())) {
  486.     return z2;
  487.   } else if (equal(z2,ltwotees())) {
  488.     return z1;
  489.   } else {
  490.     return(mkcons(CAR_LIST,z1,z2));      
  491.   }
  492. }
  493.  
  494.  
  495.  
  496. /*--------------------------------------------------subst_list()------------*/
  497. /*
  498. /* THE EXAMPLE DISCUSSED IN THE TEXT
  499. /*
  500. ** Variable substitution
  501. ** %% Use of system fn like subst would be real efficient, except that it
  502. ** does not deal with nonrecursiveness.
  503. ** Performs a variable substitution on list, nonrecursively
  504. ** (only one substitution applied to each atomic term).  
  505. ** Usage: E.g. subst_list((p ?x ?y),((?x 1)(?y 2))) ===> (p 1 2)
  506. */
  507.  
  508.  
  509. cons *subst_list(list,substi)
  510. cons *substi,*list;
  511. {
  512.   cons *new_list = NULL;
  513.   cons *substp;
  514.   cons *term;
  515.   cons *tmp;
  516.   
  517.   while (list != NULL) {
  518.     term = list->car.p;
  519.     substp = substi;        /* get 1st substitution */
  520.     while (substp != NULL) {
  521.       if (term->type == CAR_STRING && !strcmp(term->car.s,
  522.                          substp->car.p->car.p->car.s)) {
  523.     term = substp->car.p->cdr->car.p;
  524.     break;
  525.       }
  526.       substp = substp->cdr;        /* make more subst's */
  527.     }
  528.     new_list = nconc(new_list,mkcons(CAR_LIST,copy_list(term),NULL));
  529.     list = list->cdr;è  }
  530.   return new_list;
  531. }
  532. /*
  533. /* THE ABOVE IS THE EXAMPLE DISCUSSED IN THE TEXT.
  534. /*
  535. /*--------------------------------------------------subst_prop()------------*/
  536.  
  537. /*
  538. ** subst_prop(): performs a variable substitution on proposition
  539. ** Returns a copy of the proposition with replacements according to the
  540. ** substitution list.
  541. ** Usage:  E.g. subst_prop(((p ?x)(q ?y)),((?x 1)(?y 2))) ===> ((p 1)(q 2))
  542. **
  543. ** Author:         Sony Y. Song
  544. ** Date:           7/12/88
  545. */
  546.       
  547. cons *subst_prop(list,substi)
  548. cons *substi,*list;
  549. {
  550.     int       i;
  551.     cons      *temp1,*temp2;
  552.     
  553.     temp1 = NULL;
  554.     if(list == NULL)
  555.     {
  556.         killcons(temp1);
  557.         killcons(temp2);
  558.         return NULL;
  559.     }
  560.     for(i = 1; i <= length(list); i++)
  561.     {
  562.         temp2 = nth_list(i,list);
  563.         temp1 = nconc(temp1,
  564.                  mkcons(CAR_LIST,subst_list(CAR(temp2),substi),NULL));
  565.     }
  566.     killcons(temp1);
  567.     killcons(temp2);
  568.     return temp1;
  569. }
  570.  
  571.  
  572.  
  573. /*--------------------------------------------------subst_pred()------------*/
  574.  
  575. /*
  576. ** subst_pred(): Performs nonrecursive variable substitution on a predicate
  577. ** Would be more mem-efficient if result SHARED with pred.
  578. ** Usage: E.g. subst_pred((p ?x ?y),((?x 1)(?y 2))) ===> (p 1 2)
  579. */
  580.         
  581. cons *subst_pred(pred,subst)
  582. cons *pred,*subst;
  583. {  return subst_list(pred,subst);
  584. }
  585.  
  586. cons *substitute_pred(pred,subst)
  587. cons *pred,*subst;
  588. {
  589.     int  i,j;
  590.     cons *new_list = NULL;
  591.     cons *substp;
  592.     cons *term;
  593.     cons *tmp;
  594.     
  595.     for(i = 1; i <= length(pred); i++)
  596.     {
  597. /*        term = CAR(nth_list(i,pred));*/
  598.         substp = subst;
  599.         for(j = 1; j <= length(subst); j++)
  600.         {
  601.             ;
  602.         }
  603.     }
  604. }
  605.  
  606.  
  607.  
  608. /*--------------------------------------------------subst_substlist()-----*/
  609.  
  610. /*
  611. ** subst_substlist(): perform a substitution on a substitution list 
  612. ** s-s( (((?x 1)) ((?x 2))) , ((?x ?y)) ) ==> (((?y 1)) ((?y 2)))
  613. */
  614.  
  615. cons *subst_substlist(substlist,subst)
  616. cons *substlist,*subst;
  617. {
  618.   cons *new_substlist = NULL;
  619.   cons *new_subst     = NULL;
  620.   cons *new_pair      = NULL;
  621.   cons *term,*substp,*substip,*tmp;
  622.  
  623.   while (substlist != NULL) {        /* for each substitution */
  624.     new_subst = NULL;
  625.     substp = substlist->car.p;
  626.     while (substp != NULL) {        /* for each pair */
  627.       term = substp->car.p->car.p;
  628.       substip = subst;
  629.       while (substip != NULL) {        /* for each substitution-pair */
  630.         if (!strcmp(term->car.s,substip->car.p->car.p->car.s)) {
  631.       term = substip->car.p->cdr->car.p;
  632.       break;
  633.         }
  634.     substip = substip->cdr;
  635.       }
  636.       new_subst = nconc(new_subst,
  637.         mkcons(CAR_LIST,è               mkcons(CAR_LIST,
  638.                   copy_list(term),
  639.               mkcons(CAR_LIST,
  640.                  copy_list(substp->car.p->cdr->car.p),
  641.                  NULL)),
  642.            NULL));
  643.       
  644.       substp = substp->cdr;
  645.     }
  646.     new_substlist = nconc(new_substlist,mkcons(CAR_LIST,new_subst,NULL));
  647.     substlist = substlist->cdr; 
  648.   }
  649.   return new_substlist;  
  650. }
  651.  
  652.  
  653.  
  654. /*----------------------------------------------test_subst_used()-----*/
  655.  
  656. /*
  657. **  test_subst_used():Tells if substitution has been used.
  658. **  Usage: E.g.
  659. **     test_subst_used(((?x  5)),(((?x  1))))  ===>  0
  660. **      test_subst_used(((?x  5)),(((?x  5))))  ===>  1
  661. **
  662. **  Author:       Sony Y.Song
  663. **  Date:         7/9/88
  664. */
  665.  
  666. int test_subst_used(list1,prev_subst)
  667. cons  *list1,*prev_subst;
  668. {
  669.     int   i,j;
  670.     int   flag = 0;
  671.     cons  *temp1,*temp2;
  672.     
  673.     for(i=1;i<=length(list1);i++)
  674.     {
  675.        flag = 0;
  676.        temp1 = nth_list(i,list1);
  677.        for(j=1;j<=length(prev_subst);j++)
  678.        {
  679.         temp2 = nth_list(j,prev_subst);
  680.         if(equal(temp1,CAR(temp2)))
  681.         {
  682.             flag = 1;
  683.             break;
  684.         }
  685.        }
  686.        if(flag == 1)
  687.        {
  688.         return 1;                /*at least one not used*/
  689.        }
  690.           }
  691.       return 0;                      /*all used*/è}
  692.  
  693.          Listing 4-4 The LISP Code for Substitution 
  694.  
  695.  
  696. ;;; **********************************************************************
  697. ;;; Variable substitution
  698. ;;; %% Use of system fn like subst would be real efficient, except that it
  699. ;;; does not deal with nonrecursiveness.
  700.  
  701. ;;; Performs a variable substitution on list, nonrecursively
  702. ;;; (only one substitution applied to each atomic term).  
  703.  
  704. (defmacro aif (test-form &rest body)
  705.   `(let ((it ,test-form))
  706.      (if it ,@body)))
  707.  
  708. (defun Subst-List (list subst)
  709.   (declare (special subst))
  710.   (mapcar #'(lambda (term) (aif (assoc term subst) (cdr it) term)) list))
  711. ;;;
  712. ;;; THE ABOVE IS THE EXAMPLE DISCUSSED IN THE TEXT
  713. ;;;
  714. ;;; Performs a variable substitution on expression, nonrecursively
  715. ;;; Used backtrack
  716. (defun Subst-Exp (exp subst)
  717.   (declare (special exp subst))
  718.   (cond ((not exp) nil)
  719.     ((atom exp)
  720.      (or (some #'(lambda (s) (when (eq (car s) exp) (cdr s))) subst)
  721.           exp))
  722.     (t (mapcar #'(lambda (piece) (subst-exp piece subst)) exp))))
  723.  
  724. ;;; Performs nonrecursive variable substitution on a predicate
  725. ;;; Would be more mem-efficient if result SHARED with pred.
  726. ;;; NB: Subst not applied to first term!!
  727. (defun Subst-Pred (pred subst)
  728.   (declare (special subst))
  729.   (cons (car pred)
  730.     (mapcar #'(lambda (term) (aif (assoc term subst) (cdr it) term))
  731.         (cdr pred))))
  732.  
  733. ;;; Performs a variable substitution on proposition, nonrecursively
  734. ;;; (only one substitution applied to each atomic term).
  735. ;;; NB: Subst not applied to first term!!
  736. (defun Subst-Prop (prop subst)
  737.   (declare (special prop subst))
  738.   (cond ((not prop) nil)
  739.     ((atom prop)
  740.      (or (some #'(lambda (s) (when (eq (car s) prop) (cdr s))) subst)
  741.           prop))
  742.     (t (cons (car prop)
  743.          (mapcar #'(lambda (piece) (subst-Prop piece subst))
  744.              (cdr prop))))))
  745. ;;; This is slower, but more memory-efficient...è;    (t (let ((car (substitute-nonrecursive (car proposition) substitution))
  746. ;        (cdr (substitute-nonrecursive (cdr proposition) substitution)))
  747. ;         (if (and (eq car (car proposition)) (eq cdr (cdr proposition)))
  748. ;         proposition (cons car cdr))))))
  749.  
  750. (defun Subst-Substlist (substlist subst)
  751.   (declare (special subst))
  752.   (mapcar #'(lambda (sl)
  753.           (mapcar #'(lambda (s) (aif (assoc (car s) subst)
  754.                      (list* (cdr it) (cdr s)) s))
  755.               sl))
  756.       substlist))
  757.  
  758. ;;; **********************************************************************
  759. ;;; Tells if substitution has been used.  **** Used everywhere ***
  760. ;;; I.e., there is a prev-subst in prev-substs that is contained in poss-subst.
  761. ;;; (subst-used? '((?x . 5)) '(((?x . 1))))  --> NIL
  762. ;;; (subst-used? '((?x . 5)) '(((?x . 5))))  --> T
  763. ;;; (subst-used? '((?x . 5)) '(((?x . 5) (?y . 3))))  --> NIL
  764. ;;; {because there might be some other way to get ?y}
  765. ;;; (subst-used? '((?x . 1) (?y . 1)) '(((?x . 1)))) --> T
  766. ;;; {Because this is clearly not a new solution when we just want a new ?x}
  767. ;;;   Heuristic is, "I don't want a solution that is the Same (for my 
  768. ;;;   purposes) as any of these"
  769. (defun Subst-Used? (poss-subst prev-substs)
  770.   (declare (special poss-subst))
  771. ;  (find subst prev-substs :test #'equal))
  772.   (some #'(lambda (prev-subst)
  773.         (subset-equal prev-subst poss-subst))
  774.     prev-substs))
  775. #| 
  776.  we use #'SUBSET-EQUAL here because we want cases like
  777. (stash '(and (p 1) (r 1 2) (r 2 2)))
  778. (create-rule nil :premise '(r ?x ?y) :conclusion '(p ?x))
  779. (query-all '(p ?x)) 
  780. to find the solution (?x . 2).  It WON'T be found if 
  781. (achieve '(r ?x ?y) '(((?x . 1)))) returns ((?x . 1) (?y . 2))
  782. Optional guts for above:
  783.         (let ((some-are-same?))
  784.           (if (dolist (sub prev-subst)
  785.             (if (member-equal sub poss-subst) (setq some-are-same? t)
  786.               (if (and (member (car sub) poss-subst ; really need :key
  787.                    :test #'(lambda (item elt) (eq item (car elt))))
  788.                    (not (member-equal sub poss-subst)))
  789.               ; one of the subs in prev is different.
  790.               (return t))))
  791.           nil
  792.         some-are-same?)))   |#
  793.  
  794. ;;; Tells if containee is a condensed version of container.
  795. ;;; Used in find-goal-stack.
  796. (defun Condensed-Substs? (containee container)
  797.   (and (equal (list-length containee) (list-length container))
  798.        (every #'subset-equal containee container)))
  799.